home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SHELLS / SZ2 / GVIDEO.IMP < prev    next >
Text File  |  1992-08-31  |  8KB  |  257 lines
  1.    {*******************************************************************
  2.  
  3.    GVIDEO.IMP
  4.  
  5.    *******************************************************************}
  6.    {===================================================================
  7.  
  8.    BORDER.  Color Range is 0..15 (same as CRT unit constants)
  9.  
  10.    0-Black   4-Red         8-DarkGray     12-LightRed
  11.    1-Blue    5-Magenta     9-LightBlue    13-LightMagenta
  12.    2-Green   6-Brown      10-LightGreen   14-Yellow
  13.    3-Cyan    7-LightGray  11-LightCyan    15-White
  14.  
  15.    Certain EGA/VGA systems have modified BIOS' which messes up the
  16.    palette.  Noted on an external color monitor for a "lunchbox"
  17.    portable with built-in plasma display; apparently, manufacturer
  18.    attempts to simulate color with shading.
  19.  
  20.    ===================================================================}
  21. procedure SetBorder ( Color : byte ) ;
  22. var
  23.    R                         : Registers ;
  24. begin
  25.    if not AllowBorderColors then EXIT ;               { global option }
  26.    if Application <> NIL then
  27.       if AppPalette <> apColor then
  28.          Color               := 0 ;                           { BLACK }
  29.    with R do
  30.    begin
  31.       AH                     := $0B ;
  32.       BH                     := $00 ;
  33.       BL                     := Color ;
  34.       Intr ( $10 , R ) ;
  35.    end ;
  36. end ;
  37.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  38.  
  39.    VIDEO
  40.  
  41.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  42.    {===================================================================
  43.  
  44.    MONITOR TYPE
  45.  
  46.    ===================================================================}
  47. function IsMono : boolean ;
  48. var
  49.    CrtMode                   : byte ABSOLUTE $0040:$0049 ;
  50. begin
  51.    IsMono                    := CrtMode = 7 ;
  52. end ;
  53.    {===================================================================
  54.  
  55.    VIDEO MEMORY
  56.  
  57.    ===================================================================}
  58. function HardwareScreenBuffer : pointer ;
  59. begin
  60.    if IsMono then
  61.       HardwareScreenBuffer   := PTR ( $B000 , 0 )
  62.    else
  63.       HardwareScreenBuffer   := PTR ( $B800 , 0 ) ;
  64. end ;
  65.    {===================================================================
  66.  
  67.    VIDEO MEMORY - automatic DesqView support (see APP.PAT for APP.PAS)
  68.  
  69.    ===================================================================}
  70. function MyScreenBuffer : pointer ;
  71. var
  72.    DesqViewScreen            : word ;
  73. begin
  74. {$IFDEF desqview }
  75.    DesqViewScreen            := DV_Get_Video_Buffer ;
  76.    if DesqViewScreen > 0 then
  77.       MyScreenBuffer         := PTR ( DESQviewScreen , 0 )
  78.    else
  79. {$ENDIF}
  80.       MyScreenBuffer         := HardwareScreenBuffer ;
  81. end ;
  82.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  83.  
  84.    SCREEN PUSH/POP
  85.  
  86.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  87.    {===================================================================
  88.  
  89.    VIDEO
  90.    Note:  Non-standard super-VGA may not update correctly.
  91.           Became valid starting with EGA cards.
  92.  
  93.    ===================================================================}
  94. function BiosHeight : byte ;
  95. var
  96.    BiosScreenRows            : byte ABSOLUTE $0040 : $0084 ;
  97. begin
  98.    if BiosScreenRows = 0 then
  99.       BiosHeight             := 25
  100.    else
  101.       BiosHeight             := BiosScreenRows + 1 ;
  102. end ;
  103.  
  104. function BiosWidth : byte ;
  105. var
  106.    CrtMode                   : byte ABSOLUTE $0040:$0049 ;
  107. begin
  108.    case CrtMode of
  109.    0 ,
  110.    1 : BiosWidth             := 40 ;
  111.    2 ,
  112.    3 ,
  113.    7 : BiosWidth             := 80 ;
  114.    else
  115.       BiosWidth              := 80 ;
  116.    end ;
  117. end ;
  118.    {===================================================================
  119.  
  120.    BUFFER - calculate based on BIOS height
  121.  
  122.    ===================================================================}
  123. function VideoBufSize : word ;
  124. begin
  125.    VideoBufSize              := BiosWidth * BiosHeight * 2 ;
  126. end ;
  127.    {===================================================================
  128.  
  129.    SAVE
  130.  
  131.    ===================================================================}
  132. procedure PushScreen ;
  133. var
  134.    Buf                       : pointer ;
  135. begin
  136.    if SaveScreen <> NIL then EXIT ;
  137.    if VideoBufSize > MaxAvail then EXIT ;
  138.    OldX                      := WhereX ;
  139.    OldY                      := WhereY ;
  140.    OldBufSize                := VideoBufSize ;
  141.    GetMem ( SaveScreen , OldBufSize ) ;
  142.    Buf                       := MyScreenBuffer ;
  143.    Move ( Mem [ Seg ( Buf^ ) : 0 ] , SaveScreen^ , OldBufSize ) ;
  144. end ;
  145.    {===================================================================
  146.  
  147.    SHOW
  148.  
  149.    ===================================================================}
  150. procedure PullScreen ;
  151. var
  152.    Buf                       : pointer ;
  153. begin
  154.    if SaveScreen = NIL then EXIT ;
  155.    Buf                       := MyScreenBuffer ;
  156.    Move ( SaveScreen^, Mem [ Seg ( Buf^ ) : 0 ] , OldBufSize ) ;
  157.    GotoXY ( OldX , OldY ) ;
  158. end ;
  159.    {===================================================================
  160.  
  161.    FREE - Release memory without re-display
  162.  
  163.    ===================================================================}
  164. procedure FreeScreen ;
  165. begin
  166.    if SaveScreen = NIL then EXIT ;
  167.    FreeMem ( SaveScreen , OldBufSize ) ;
  168.    SaveScreen                := NIL ;
  169. end ;
  170.    {===================================================================
  171.  
  172.    RESTORE
  173.  
  174.    ===================================================================}
  175. procedure PopScreen ;
  176. begin
  177.    PullScreen ;
  178.    FreeScreen ;
  179. end ;
  180.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  181.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  182.    {===================================================================
  183.  
  184.    OFFSET
  185.  
  186.    ===================================================================}
  187. function CharOffset ( x , y : byte ) : word ;
  188. begin
  189.    if x < 1 then x           := 1 ;
  190.    if y < 1 then y           := 1 ;
  191.    if x > BiosWidth then x   := BiosWidth ;
  192.    if y > BiosHeight then y  := BiosHeight ;
  193.    CharOffset                := ( ( Y - 1 ) * BiosWidth + x - 1 ) * 2 ;
  194. end ;
  195.    {===================================================================
  196.  
  197.    CHAR
  198.  
  199.    ===================================================================}
  200. function GetChar ( x , y : byte ; Vid : pointer ) : char ;
  201. begin
  202.    if Vid <> NIL then 
  203.       GetChar                := chr ( Mem [ Seg ( Vid^ ) :
  204.                                             CharOffset ( x , y ) ] )
  205.    else
  206.       GetChar                := #0 ;
  207. end ;
  208.    {===================================================================
  209.  
  210.    LINE
  211.  
  212.    ===================================================================}
  213. function GetLine ( y : byte ; Vid : pointer ) : string ;
  214. var
  215.    x                         : byte ;
  216.    S                         : string ;
  217. begin
  218.    S                         := '' ;
  219.    if Vid <> NIL then
  220.       for x := 1 to BiosWidth do
  221.          S                   := S + chr ( Mem [ Seg ( Vid^ ) :
  222.                                           CharOffset ( x , y ) ] ) ;
  223.    GetLine                   := S ;
  224. end ;
  225.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  226.  
  227.    INTERFACE
  228.  
  229.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  230.    {===================================================================
  231.  
  232.    OFF
  233.  
  234.    ===================================================================}
  235. procedure VisionOFF ;
  236. begin
  237.    DoneSysError ;
  238.    DoneEvents ;
  239.    SaveSnow                  := DRIVERS.CheckSnow ; { InitVideo resets }
  240.    DoneVideo ;
  241.    DoneMemory ;
  242. end ;
  243.    {===================================================================
  244.  
  245.    ON
  246.  
  247.    ===================================================================}
  248. procedure VisionON ;
  249. begin
  250.    InitMemory ;
  251.    InitVideo ;
  252.    DRIVERS.CheckSnow         := SaveSnow ;         { InitVideo resets }
  253.    InitEvents ;
  254.    InitSysError ;
  255.    hdRefreshDisplay ;
  256. end ;
  257.